home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Text files / DataFiles < prev    next >
Encoding:
Text File  |  1988-06-13  |  1.6 KB  |  40 lines  |  [TEXT/EDIT]
  1. ( datafiles 9 June 1988 )
  2. ( a possible scheme for creating and accessing data files )
  3.  
  4. : "GETNAME ( -- addr ) 34 word here ;
  5.  
  6. variable FCB 78 allot  ( our File's Control Block )
  7. : +FCB ( offset -- addr ) fcb + ;  ( offset into fcb )
  8. : 0FCB ( -- ) fcb 80 0 fill ;
  9. : FTRAP ( -- ) fcb >abs  ,$ 205E ;  ( movea.l [ps]+,a0 )
  10.  
  11. : CLOSE ( -- ) ftrap ,$ A001  ftrap ,$ A013 ;  ( close & flush )
  12. : ?DERROR ( -- ) 16 +fcb @ ?dup IF  ( if result not zero )
  13.       ." DiskError" .  close  abort THEN ;  ( report & abort )
  14.  
  15. : EOF ( -- dbytes ) ftrap ,$ A011  30 +fcb @ ;  ( _GetEOF )
  16. : !SIZE ( bytes -- ) 38 +fcb ! ;  ( set bytes-to-read or write )
  17. : !NAME ( name.addr -- ) >abs  0fcb  18 +fcb  2! ;  ( set name )
  18.  
  19. : NEW ( name.addr -- ) !name  ftrap ,$ A008  ?derror ;  ( _Create )
  20. : "NEW ( -- ) "getname new ;  ( get a name and create a file )
  21.  
  22. : OPEN ( -- ) ftrap ,$ A000  ?derror ;  ( _Open the file )
  23. : "OPEN ( -- ) "getname !name 1 27 +fcb c! open ;  ( read only )
  24. : "RWOPEN ( -- ) "getname !name open ;  ( read and write )
  25.  
  26. : READ ( dabs.addr -- ) ( allows read outside of dictionary )
  27.     32 +fcb 2!  ( set read buffer pointer )
  28.     ftrap ,$ A002  ?derror ;  ( _Read )
  29. : WRITE ( dabs.addr -- )
  30.     32 +fcb 2!  ( set write buffer pointer )
  31.     ftrap ,$ A003  ?derror ;  ( _Write )
  32.  
  33. : DISK ( n -- ) ( set the default volume to n )
  34.     0fcb  22 +fcb !  ftrap ,$ A015  ?derror ;  ( _SetVol )
  35.  
  36. : "LIST ( -- ) ( list a file )
  37.     "open  eof  dup 0< IF abs THEN  ( determine file length )
  38.     room 44 -  min  dup !size  ( set bytes to be read )
  39.     pad dup >abs read  close  swap type ;  ( read & type data )
  40.